home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1997 July / EnigmA AMIGA RUN 20 (1997)(G.R. Edizioni)(IT)[!][issue 1997-07 & 08][EAR-CD IV].iso / earcd / dev / amos / moreusel.lha / Gearwheel2.AMOS / Gearwheel2.amosSourceCode
AMOS Source Code  |  1997-04-15  |  3KB  |  93 lines
  1. Screen Open 1,320,256,2,0 : Screen Hide 
  2. Curs Off : Cls 0
  3. Screen Open 0,320,256,4,0 : Screen To Front 1
  4. Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 0
  5. Palette $0,$8F8,$484,$8F8
  6. Double Buffer 
  7. Autoback 0
  8. W=0
  9. WX=0 : WY=256 : WZ=0 : ST= Extension_8_04F8(Rnd(3)+3) : ROT=1
  10.  Extension_8_1122 0,0,300
  11. R1MX1=319 : R1MY1=255 : R1MX2=0 : R1MY2=0
  12. R2MX1=319 : R2MY1=255 : R2MX2=0 : R2MY2=0
  13. A1MX1=319 : A1MY1=255 : A1MX2=0 : A1MY2=0
  14. A2MX1=319 : A2MY1=255 : A2MX2=0 : A2MY2=0
  15. Do 
  16.    Extension_8_121C 0,0,R2MX1,R2MY1 To R2MX2+1,R2MY2+1
  17.   Add W,6
  18.   Add WX,3
  19.   Add WY,6
  20.   Add WZ,9
  21.    Extension_8_1138 WX,WY,WZ
  22.    Extension_8_1152 
  23.    Extension_8_121C 0,1,A2MX1,A2MY1 To A2MX2+1,A2MY2+1
  24.   D=0 : RX1=0
  25.   Z1= Extension_8_11C4(0,0,100) : Z2= Extension_8_11C4(0,0,-100)
  26.   If Z1>Z2 Then SI=0 : Z=Z1 Else SI=1 : Z=Z2
  27.   R2MX1=R1MX1 : R2MY1=R1MY1 : R2MX2=R1MX2 : R2MY2=R1MY2
  28.   R1MX1=319 : R1MY1=255 : R1MX2=0 : R1MY2=0
  29.   A2MX1=A1MX1 : A2MY1=A1MY1 : A2MX2=A1MX2 : A2MY2=A1MY2
  30.   A1MX1=319 : A1MY1=255 : A1MX2=0 : A1MY2=0
  31.   For A=0 To 1023 Step ST
  32.     If D<2
  33.       X2= Extension_8_1114(A+W+(D and 1)*ST-(ST/2),96-ST)
  34.       Y2= Extension_8_1106(A+W+(D and 1)*ST-(ST/2),96-ST)
  35.     Else 
  36.       X2= Extension_8_1114(A+W,96)
  37.       Y2= Extension_8_1106(A+W,96)
  38.     End If 
  39.     RX2= Extension_8_1168(X2,Y2,10)+160
  40.     RY2= Extension_8_1184 +128
  41.     RX4= Extension_8_1168(X2,Y2,-10)+160
  42.     RY4= Extension_8_1184 +128
  43.     Add D,1,0 To 3
  44.     If RX1=0
  45.       OX1=RX2 : OY1=RY2 : OX3=RX4 : OY3=RY4
  46.     Else 
  47.       Gosub DRAPOINT
  48.     End If 
  49.     RX1=RX2 : RY1=RY2 : RX3=RX4 : RY3=RY4
  50.   Next 
  51.   RX2=OX1 : RY2=OY1 : RX4=OX3 : RY4=OY3
  52.   Gosub DRAPOINT
  53.    Extension_8_1042 0,0,R1MX1,R1MY1,R1MX2+1,R1MY2+1
  54.   Screen Swap 
  55.   Wait Vbl 
  56.   C=(Z-300)/7
  57.   Colour 1,C*$110
  58.   Colour 3,C*$110
  59.   Colour 2,(15-C)*$10
  60. Loop 
  61. DRAPOINT:
  62.   Screen 1
  63.   MX1=Min(Min(Min(RX1,RX2),RX3),RX4)
  64.   A1MX1=Min(A1MX1,MX1)
  65.    Extension_8_1016 RX1,RY1 To RX2,RY2,1,-1
  66.   MX2=Max(Max(Max(RX1,RX2),RX3),RX4)
  67.   A1MX2=Max(A1MX2,MX2)
  68.    Extension_8_1016 RX2,RY2 To RX4,RY4,1,-1
  69.   MY1=Min(Min(Min(RY1,RY2),RY3),RY4)
  70.   A1MY1=Min(A1MY1,MY1)
  71.    Extension_8_1016 RX3,RY3 To RX4,RY4,1,-1
  72.   MY2=Max(Max(Max(RY1,RY2),RY3),RY4)
  73.   A1MY2=Max(A1MY2,MY2)
  74.    Extension_8_1016 RX1,RY1 To RX3,RY3,1,-1
  75.    Extension_8_1042 1,0,MX1,MY1,MX2+1,MY2+1
  76.    Extension_8_128A MX1,MY1 To MX2+1,MY2+1
  77.    Extension_8_12B2 1,0,0,1 To 0,1,%11111100
  78.    Extension_8_121C 1,0,MX1,MY1 To MX2+1,MY2+1
  79.   Screen 0
  80.   If SI
  81.     R1MX1=Min(Min(R1MX1,RX1),RX2)
  82.     R1MY1=Min(Min(R1MY1,RY1),RY2)
  83.     R1MX2=Max(Max(R1MX2,RX1),RX2)
  84.     R1MY2=Max(Max(R1MY2,RY1),RY2)
  85.      Extension_8_1016 RX1,RY1 To RX2,RY2,1,-1
  86.   Else 
  87.     R1MX1=Min(Min(R1MX1,RX3),RX4)
  88.     R1MY1=Min(Min(R1MY1,RY3),RY4)
  89.     R1MX2=Max(Max(R1MX2,RX3),RX4)
  90.     R1MY2=Max(Max(R1MY2,RY3),RY4)
  91.      Extension_8_1016 RX3,RY3 To RX4,RY4,1,-1
  92.   End If 
  93. Return